home *** CD-ROM | disk | FTP | other *** search
/ Mac Cube 4: Multimedia Applications / MacCube Volume 4: Multimedia Applications.iso / Graphics / NIH Image Folder / Macros / More Macros < prev    next >
Text File  |  1993-09-01  |  9KB  |  433 lines
  1. macro 'Fix Pseudocolors';
  2. begin
  3.   ChangeValues(0,0,1);
  4.   ChangeValues(255,255,254);
  5. end;
  6.  
  7.  
  8. macro 'Fast Invert';
  9. begin
  10.   Invert;
  11. end;
  12.  
  13.  
  14. macro 'Slow Invert';
  15. {
  16. This macro illustrates why it's not a good idea to use
  17. macros for pixel-by-pixel processing.
  18. }
  19. var
  20.   width,height,value,x,y:integer;
  21. begin
  22.   RequiresVersion(1.44);
  23.   GetPicSize(width,height);
  24.   for y:=0 to height-1 do begin
  25.     GetRow(0,y,width);
  26.     for x:=0 to width-1 do LineBuffer[x]:=255-LineBuffer[x];
  27.     PutRow(0,y,width);
  28.   end;
  29. end;
  30.  
  31.  
  32. macro 'Remove Isolated Black Lines';
  33. var
  34.   width,height,value,x,y,xstart,ystart:integer;
  35. begin
  36.   GetRoi(xstart,ystart,width,height);
  37.   if width=0 then begin
  38.     PutMessage('This macro requires a retangular selection');
  39.     exit;
  40.   end;
  41.   for y:=ystart to ystart+height-1 do begin
  42.     if GetPixel(width div 2,y)=255 then
  43.       for x:=xstart to xstart+width-1 do
  44.         PutPixel(x,y,(GetPixel(x,y-1)+GetPixel(x,y+1))/2);
  45.   end;
  46.   KillRoi;
  47. end;
  48.  
  49.  
  50. macro 'Make Mosaic';
  51. var
  52.   n:integer;
  53. begin
  54.   SaveState
  55.   n:=GetNumber('Cell Size(pixels square):',8);
  56.   Duplicate('Mosaic');
  57.   SetScaling('Nearest; Same Window');
  58.   ScaleSelection(1/n,1/n);
  59.   RestoreRoi;
  60.   ScaleSelection(n,n);
  61.   RestoreState;
  62. end;
  63.  
  64.  
  65. macro 'Draw Vertical Calibration Bar';
  66. var
  67.   left,top,width,height,i,x,y2,inc:integer;
  68.   y:real;
  69. begin
  70.   GetRoi(left,top,width,height);
  71.   if width=0 then begin
  72.     PutMessage('Make a selection first.');
  73.     exit;
  74.   end;
  75.   SetFont('Helvetica');
  76.   SetFontSize(10);
  77.   SetText('Plain; Left; no background');
  78.   SetLineWidth(1);
  79.   Setforeground(255);
  80.   DrawScale;
  81.   x:=left;
  82.   y:=top;
  83.   inc:=height/10;
  84.   for i:=1 to 11 do begin
  85.     MoveTo(x+width+10,round(y)+2);
  86.     y2:=round(y);
  87.     if i=11 then y2:=y2-1;
  88.     write(cvalue(GetPixel(x,y2)):1:2);
  89.     y:=y+inc;
  90.   end;
  91. end;
  92.  
  93.  
  94. macro 'Draw Histogram';
  95. var
  96.   max,scale:real;
  97.   i,margin,width,height:integer;
  98. begin
  99.   SaveState;
  100.   Margin:=10;
  101.   width:=256;
  102.   height:=0.6*256;
  103.   Measure;
  104.   SetForegroundColor(255);
  105.   SetBackgroundColor(0);
  106.   SetLineWidth(1);
  107.   SetNewSize(width+2*margin,height+2*margin);
  108.   MakeNewWindow('Histogram');
  109.   MakeRoi(margin,margin-1,width,height+1);
  110.   DrawBoundary;
  111.   max:=0;
  112.   for i:=1 to 254 do
  113.   if histogram[i]> max then max:=histogram[i];
  114.   scale:=height/max;
  115.   for i:=1 to 254 do begin
  116.     MakeRoi(margin+i,margin,1,histogram[i]*scale);
  117.     SetForegroundColor(i);
  118.     fill;
  119.  end;
  120.   SelectAll;
  121.   FlipVertical;
  122.   KillRoi;
  123.   RestoreState;
  124. end;
  125.  
  126.  
  127. macro 'Subtract Background [B]';
  128. var
  129.   i,Corrected,smoothf:integer;
  130.   scalef:real;
  131. begin
  132.   scalef:=.125;
  133.   smoothf:=10;
  134.   SelectAll;
  135.   Duplicate('Background Corrected');
  136.   Corrected:=PicNumber;
  137.   Duplicate('Background');
  138.   SetScaling('Bilinear'); 
  139.   ScaleSelection(scalef,scalef);
  140.   RestoreRoi;
  141.   for i:=1 to smoothf do begin
  142.     SetOption; Smooth;
  143.   end;
  144.   ScaleSelection(1/scalef,1/scalef);
  145.   ScaleMath(false);
  146.   SelectAll;
  147.   Copy;
  148.   SelectPic(Corrected);
  149.   Paste;
  150.   Subtract;
  151.   ResetGrayMap;
  152. end;
  153.  
  154.  
  155. macro 'ASCII Dump';
  156. {
  157. Generates an alphanumeric listing of pixels values starting at
  158. the upper left corner of the current selection. 20 rows and 44 columns
  159. can be displayed with the default 552 x 436 window. The size of the window
  160. used to display the pixel values is determined by New Width and
  161. New Height in the Prefernces dialog box.
  162. }
  163. var
  164.   image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer;
  165.   h,v,value,MaxWidth,MaxHeight,width,height:integer;
  166. begin
  167.   image:=PicNumber;
  168.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  169.   if roiWidth=0 then begin
  170.     PutMessage('This macro requires a rectangular selection');
  171.     exit;
  172.   end;
  173.   SetForegroundColor(255);
  174.   SetBackgroundColor(0);
  175.   MakeNewWindow('ASCII Dump');
  176.   dump:=PicNumber;
  177.   GetPicSize(width,height);
  178.   MaxWidth:=width div 24 - 2;
  179.   MaxHeight:=height div 9 - 3;
  180.   if roiWidth>MaxWidth then roiWidth:=MaxWidth;
  181.   if roiHeight>MaxHeight then roiHeight:=MaxHeight;
  182.   SetFont('Monaco');
  183.   SetFontSize(9);
  184.   SetText('With background; Left Justified');
  185.   MoveTo(2,12);
  186.   write('    ');
  187.   for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4);
  188.   writeln;
  189.   writeln;
  190.   for v:=roiTop to roiTop+roiHeight-1 do begin
  191.     write(v:3,' ');
  192.     for h:=roiLeft to roiLeft+roiWidth-1 do begin
  193.       ChoosePic(image);
  194.       value:=GetPixel(h,v);
  195.       ChoosePic(dump);
  196.       write(value:4);
  197.     end;
  198.     writeln;
  199.   end;
  200.   ChoosePic(image);
  201. end;
  202.  
  203.  
  204. macro 'Resize All';
  205. {
  206. Resizes and/or rotates all currently open widows. For example,
  207. change the  ScaleAndRotate command below to
  208. ScaleAndRotate(2,2,0)  to change the size of all the images
  209. in a movie loop sequence from 128 x 128 to 256 x 256.
  210. }
  211. var
  212.   i:integer;
  213. begin
  214.   SaveState;
  215.   SetScaling('Bilinear; Create New Window');
  216.   for i:=1 to nPics do begin
  217.     ChoosePic(1);
  218.     ScaleAndRotate(1.9,1.9,0);
  219.     ChoosePic(1);
  220.     Close;
  221.   end;
  222.   for i:=1 to nPics do begin
  223.     ChoosePic(i);
  224.     SetPicName(i);
  225.   end;
  226.   RestoreState;
  227. end;
  228.  
  229.  
  230. macro 'Dispose All';
  231. begin
  232.   DisposeAll;
  233. end;
  234.  
  235. macro 'Average two Images';
  236.   {Generates the arithmetic average of two images.}
  237. begin
  238.   if nPics<>2 then begin
  239.     PutMessage('This macro requires exactly two image windows to be open.');
  240.     Exit;
  241.   End;
  242.   ScaleMath(false);
  243.   MultiplyByConstant(0.5);
  244.   NextWindow;
  245.   MultiplyByConstant(0.5);
  246.   SelectAll;
  247.   Copy;
  248.   NextWindow;
  249.   Paste;
  250.   Add;
  251. end;
  252.  
  253.  
  254. macro 'Make Montage [M]';
  255. {Opens a new window and creates in it a composite image made from all}
  256. {currently open images. All the images must be the same size.}
  257. var
  258.   width,height,w,h,mWidth,mHeight,nWindows,left,top:integer;
  259.   RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer;
  260.   montage,temp:integer;
  261.   scale:real;
  262.   SameSize:boolean;
  263. begin
  264.   nWindows:=nPics;
  265.   SameSize:=true;
  266.   GetPicSize(width,height);
  267.   for i:=1 to nPics do begin
  268.     SelectPic(i);
  269.     GetPicSize(w,h);
  270.     SameSize:=SameSize and (w=width) and (h=height);
  271.   end;
  272.   if (nWindows<2) or not SameSize then begin
  273.     PutMessage('This macro needs two or more images of the same size in order to create a montage.');
  274.     Exit;
  275.   end;
  276.   SetBackground(0);
  277.   MakeNewWindow('Montage');
  278.   montage:=nWindows+1;
  279.   GetPicSize(mWidth,mHeight);
  280.   SelectPic(1);
  281.   Duplicate('Temp');
  282.   temp:=nWindows+2;
  283.   scale:=GetNumber('Scaling Factor:',0.25);
  284.   hloc:=-(RoiWidth);
  285.   vloc:=0;
  286.   for i:=1 to nWindows do begin
  287.     SelectPic(i);
  288.     SelectAll;
  289.     copy;
  290.     SelectPic(temp);
  291.     paste;
  292.     SelectAll;
  293.     ScaleSelection(scale,scale);
  294.     RestoreRoi;
  295.     if i=1 then begin
  296.       GetRoi(left,top,RoiWidth,RoiHeight);
  297.       hloc:=-RoiWidth;
  298.       vloc:=0;
  299.     end;
  300.     Copy;
  301.     SelectPic(montage);
  302.     hloc:=hloc+RoiWidth;
  303.     if (hloc+RoiWidth)>mWidth then begin
  304.       hloc:=0;
  305.       vloc:=vloc+RoiHeight;
  306.     end;
  307.     MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
  308.     Paste;
  309.   end;
  310.   KillRoi;
  311.   SelectPic(temp);
  312.   Dispose;
  313. end;
  314.  
  315.  
  316. macro 'Make Sine Wave';
  317. var
  318.   left,top,width,height,i:integer;
  319.   ppp,scale:real;
  320. begin
  321.   SaveState;
  322.   MakeNewWindow('Sine Wave');
  323.   SelectAll;
  324.   GetRoi(left,top,Width,Height);
  325.   if width=0 then begin
  326.     PutMessage('This macro requires a rectangular selection.');
  327.     Exit;
  328.   end;
  329.   ppp:=GetNumber('Pixels per period',100);
  330.   Scale:=ppp/6.28;
  331.   MakeRoi(left,top,1,height);
  332.   for i:=1 to width do begin
  333.     SetForeground(sin(i/scale)*127 +128);
  334.     {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));}
  335.     {SetForeground(sin(i/(ppp*((width-i+3)/width)/6.28))*127 +128);}
  336.     fill;
  337.     MoveRoi(1,0);
  338.   end;
  339.   KillRoi;
  340.   RestoreState;
  341. end;
  342.  
  343.  
  344. macro 'Plot XYZ';
  345. {
  346. Plots X-Y coordinate points with an optional intensity(Z). Values are read from
  347. a 2 or 3 column tab-delimited text file. Data must be scaled as follows:
  348. 0<=X<width; 0<=Y<height; 0<=Z<=255.
  349. }
  350. var
  351.   width,height:integer;
  352. begin
  353.   SaveState;
  354.   width:=500;
  355.   height:=500;
  356.   SetNewSize(width,height);
  357.   SetForeground(255);
  358.   SetBackground(0);
  359.   MakeNewWindow('Plot');
  360.   PlotXYZ;
  361.   RestoreState;
  362. end;
  363.  
  364.  
  365. macro 'Normalize to 0 to 255';
  366. {
  367. Similar to enhance contrast but alters the pixel data instead of generating
  368. a LUT function. Can be used to normalize multiple images to the same
  369. brightness scale when creating a poster.
  370. }
  371. var
  372.   min,max,count:integer;
  373. begin
  374.   ResetCounter;
  375.   Measure;
  376.   count:=rCount;
  377.   min :=rMin[count];
  378.   max:=rMax[count];
  379.   KillROI;
  380.   SelectAll;
  381.   AddConstant(-min);
  382.   Max:=Max-min;
  383.   MultiplyByConstant(255/max);
  384.   ShowMessage('Results are best if a ROI is drawn before the macro is executed');
  385.  end;
  386.  
  387.  
  388. macro 'Change Values';
  389. var
  390.   v1,v2:integer;
  391. begin
  392.   v1:=GetNumber('Change pixels with this value:',255);
  393.   v2:=GetNumber('to this value:',254);
  394.   ChangeValues(v1,v1,v2);
  395. end;
  396.  
  397.  
  398. macro '(---'; begin end;
  399.  
  400. macro '5x5';
  401. {
  402. Note: you only see the open file dialog box the first time one of
  403. these macros is called, since Image keeps track of the folder
  404. containing the convolution kernels.
  405. }
  406. begin
  407.   convolve('Hat(5x5)');
  408. end;
  409.  
  410. macro '7x7'
  411. begin
  412.   convolve('Hat(7x7)');
  413. end;
  414.  
  415. macro '9x9]'
  416. begin
  417.   convolve('Hat(9x9)');
  418. end;
  419.  
  420.  
  421. macro '(---'; begin end;
  422.  
  423. {These macros allow you to easily switch}
  424. {transfer modes while pasting by tapping keys.}
  425. macro 'Copy Mode[1]'; begin SetOption; DoCopy; end;
  426. macro 'AND Mode[2]';  begin SetOption; DoAnd; end;
  427. macro 'OR Mode [3]';  begin SetOption; DoOr; end;
  428. macro 'XOR Mode[4]'; begin SetOption; DoXor; end;
  429. macro 'REPLACE Mode[5]';  begin SetOption; DoReplace; end;
  430. macro 'BLEND [6]';  begin SetOption; DoBlend; end;
  431. macro 'Terminate Paste [7]'; begin KillRoi end;
  432.  
  433.